home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / pavt117.zip / AVIDEO.INC next >
Text File  |  1991-12-23  |  5KB  |  216 lines
  1. { Include file for the demo programs in PAvatar. }
  2. { These are the video and user hook routines     }
  3. { if the compiler directive AVT0 is set then it  }
  4. { will compile to be compatible with the PAvt0   }
  5. { unit.  Otherwise PAvt1 is assumed.             }
  6.  
  7. type
  8.   ScreenWord = record
  9.                  chr  : char;
  10.                  attr : byte;
  11.                end;
  12.   ScreenPtr = ^Screen;
  13.   Screen = Array[1..25,1..80] of ScreenWord;
  14.  
  15. var
  16.   ScrPtr : ScreenPtr; { for direct screen writes }
  17.  
  18. {$IFDEF VER55}
  19. Function DV_Get_Video_Buffer(cseg:word): word;
  20. begin
  21.   if DESQview_version = 0 then DV_Get_Video_Buffer := cseg
  22.    else
  23.     InLine(
  24.       $b4/$fe/    {  MOV    AH,0FEH          DV's get video buffer function }
  25.       $cd/$10/    {  INT    10H              Returns ES:DI of alt buffer }
  26.       $8c/$c0);   {  MOV    AX,ES            Return video buffer }
  27. end; { DV_Get_Video_Buffer }
  28. {$ELSE}
  29. Function DV_Get_Video_Buffer(cseg:word): word; assembler;
  30. asm
  31.   MOV    ES,cseg            { Put current segment into ES }
  32.   CALL   DESQview_version   { Returns AX=0 if not in DV }
  33.   TEST   AX,AX              { In DV? }
  34.   JZ     @DVGVB_X           { Jump if not }
  35.   MOV    AH,0FEH            { DV's get video buffer function }
  36.   INT    10H                { Returns ES:DI of alt buffer }
  37.   MOV    AX,ES              { Return video buffer }
  38.   JMP    @DVGVB_E           { Exit and return DV buffer }
  39. @DVGVB_X:
  40.   MOV    AX,cseg            { Load old buffer for return to caller }
  41. @DVGVB_E:
  42. end; { DV_Get_Video_Buffer }
  43. {$ENDIF}
  44.  
  45. Procedure SetScrPtr;
  46. var
  47.   sg : word;
  48. begin
  49.   if LastMode = 7 then sg := $B000
  50.    else sg := $B800;
  51.   sg := DV_Get_Video_Buffer(sg);
  52.   ScrPtr := Ptr(sg,$0000);
  53. end;
  54.  
  55. (* Hooks *)
  56.  
  57. procedure FillWord(var x; count:integer; w:word);
  58. begin
  59.   Inline(
  60.   $c4/$be/x/
  61.   $8b/$86/w/
  62.   $8b/$8e/count/
  63.   $f2/$ab);
  64. (*  LES  DI,x              { load target address }
  65.   MOV  AX,w              { load word to fill in }
  66.   MOV  CX,count          { number of words to move }
  67.   REPNZ STOSW            { copy the data } *)
  68. end;
  69.  
  70. procedure MoveW(var Source, Dest; count:integer);
  71. begin     { Only good for single direction, moves to screen }
  72.   Inline(
  73.   $8c/$db/
  74.   $c4/$be/Dest/
  75.   $c5/$b6/Source/
  76.   $8b/$8e/count/
  77.   $f2/$a5/
  78.   $8e/$db);
  79. (*  MOV  BX,DS         { Save DS }
  80.   LES  DI,Dest         { Load destination ptr }
  81.   LDS  SI,Source       { load source ptr }
  82.   MOV  CX,Count        { load # of words to move }
  83.   REPNZ MOVSW          { move 'em }
  84.   MOV  DS,BX           { restore DS } *)
  85. end;
  86.  
  87. procedure GetXY(var x,y:byte);
  88. begin
  89.   x := WhereX;
  90.   y := WhereY;
  91. end;
  92.  
  93. {$F+}
  94. procedure SetXY(x,y:byte);
  95. begin
  96.   GotoXY(x,y);
  97. end;
  98.  
  99. procedure WriteAT(x,y,a:byte;ch:char);
  100. begin
  101.   with ScrPtr^[y,x] do
  102.    begin
  103.      attr := a;
  104.      chr := ch;
  105.    end;
  106. end;
  107.  
  108. procedure FillArea(x1,y1,x2,y2,a:byte;ch:char);
  109. var
  110.   sw : screenword;
  111.   w : byte;
  112. begin
  113.   if x1 > x2 then x1 := x2;
  114.   if y1 > y2 then y1 := y2;
  115.   sw.chr := ch;
  116.   sw.attr := a;
  117.   w := succ(x2-x1);
  118.   for y1 := y1 to y2 do
  119.    FillWord(ScrPtr^[y1,x1],w,word(sw));
  120. end;
  121.  
  122. procedure Scroll(dir,x1,y1,x2,y2,n,a:byte);
  123. var
  124.   t : byte;
  125. begin
  126.   if x1 > x2 then x1 := x2;
  127.   if y1 > y2 then y1 := y2;
  128.   if n = 0 then
  129.    begin
  130.      FillArea(x1,y1,x2,y2,a,' ');
  131.      exit;
  132.    end;
  133.   case dir of
  134.     1 : begin { up }
  135.           if n > succ(y2-y1) then n := succ(y2-y1);
  136.           for t := y1+n to y2 do
  137.            MoveW(ScrPtr^[t,x1], ScrPtr^[t-n,x1], succ(x2-x1)); { move a line }
  138.           FillArea(x1,succ(y2-n),x2,y2,a,' ');
  139.         end;
  140.     2 : begin { down }
  141.           if n > succ(y2-y1) then n := succ(y2-y1);
  142.           for t := y2-n downto y1 do
  143.            MoveW(ScrPtr^[t,x1], ScrPtr^[t+n,x1], succ(x2-x1)); { move a line }
  144.           FillArea(x1,y1,x2,pred(y1+n),a,' ');
  145.         end;
  146.     3 : begin { left }
  147.           if n > succ(x2-x1) then n := succ(x2-x1);
  148.           for t := y1 to y2 do
  149.            MoveW(ScrPtr^[t,x1+n], ScrPtr^[t,x1], succ(x2-(x1+n)));
  150.           FillArea(succ(x2-n),y1,x2,y2,a,' ');
  151.         end;
  152.     4 : begin { right }
  153.           if n > succ(x2-x1) then n := succ(x2-x1);
  154.           for t := y1 to y2 do
  155.            MoveW(ScrPtr^[t,x1], ScrPtr^[t,x1+n], succ(x2-(x1+n)));
  156.           FillArea(x1,y1,pred(x1+n),y2,a,' ');
  157.         end;
  158.   end; { case dir }
  159. end;
  160.  
  161. procedure GetScrChar(x,y:byte;var a:byte;var c:char);
  162. begin
  163.   with ScrPtr^[y,x] do
  164.    begin
  165.      a := attr;
  166.      c := chr;
  167.    end;
  168. end;
  169.  
  170. procedure HighArea(x1,y1,x2,y2,a:byte);
  171. var
  172.   i,j,m : byte;
  173.   c : char;
  174. begin
  175.   if x1 > x2 then x1 := x2;
  176.   if y1 > y2 then y1 := y2;
  177.   for i := x1 to x2 do
  178.    for j := y1 to y2 do
  179.     begin
  180.       GetScrChar(i,j,m,c);
  181.       WriteAT(i,j,a,c);
  182.     end;
  183. end;
  184.  
  185. {$IFNDEF AVT0}
  186. procedure Pause(tens:word);
  187. begin
  188.   for tens := tens downto 1 do
  189.    begin
  190.      delay(100); { note that delay usually isn't accurate }
  191.      if KeyPressed then tens := 1; { abort the pause }
  192.    end;
  193. end;
  194. {$ENDIF}
  195. {$F-}
  196.  
  197. (* End Hook Definitions *)
  198.  
  199. procedure SetHooks;
  200. begin
  201. { Query_Hook := <defualt null hook for this application> }
  202.  {$IFNDEF AVT0}
  203.   Pauseh := Pause;
  204.  {$ENDIF}
  205.   HighAreah := HighArea;
  206.   GetATh := GetScrChar;
  207.   FillAreah := FillArea;
  208.   Scrollh := Scroll;
  209.   GotoXYh := SetXY;
  210.   WriteATh := WriteAT;
  211.  {$IFNDEF AVT0}
  212. { FlushInputh := <Defualt Zero keyboard buffer hook is fine> }
  213.  {$ENDIF}
  214. end;
  215.  
  216.